Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue43/alfresco/AASkpLst.pas

Pascal/Delphi Source File | 1999-01-24 | 11.8 KB | 440 lines

{*********************************************************}
{* AASkpLst                                              *}
{* Copyright (c) Julian M Bucknall 1999                  *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Skip list container                                   *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AASkpLst;

interface

uses
  SysUtils;

{$IFOPT D+}
{$DEFINE InDebugMode}
{$ENDIF}

{$DEFINE UseNodeManager}

const
  PageNodeCount = 30;
  MaxSkipLevels = 16;

type
  TaaCompareFunction = function (aItem1, aItem2 : pointer) : integer;

type
  PslNode = ^TslNode;

  TslNodeArray = array [0..pred(MaxSkipLevels)] of PslNode;

  TslNode = packed record
    slnData : pointer;
    slnLevel: longint;
    slnPrev : PslNode;
    slnNext : TslNodeArray;
  end;

  TaaSkipList = class
    private
      FCompare  : TaaCompareFunction;
      FCount    : integer;
      FCursor   : PslNode;
      FHead     : PslNode;
      FMaxLevel : integer;
      FTail     : PslNode;
    protected
      function slSearchPrim(aItem : pointer;
                        var aBeforeNodes : TslNodeArray) : boolean;
    public
      constructor Create(aCompare : TaaCompareFunction);
      destructor Destroy; override;

      procedure Insert(aItem : pointer);
      function Delete : pointer;

      function IsAfterLast : boolean;
      function IsBeforeFirst : boolean;
      procedure MoveAfterLast;
      procedure MoveBeforeFirst;

      function MoveNext : boolean;
      function MovePrior : boolean;

      procedure Clear;
      function Examine : pointer;

      function Search(aItem : pointer) : boolean;

      {$IFDEF InDebugMode}
      procedure Print;
      {$ENDIF}

      property Count : integer read FCount;
      property MaxLevel : integer read FMaxLevel;
  end;


implementation

{===SkipListNodeManager==============================================}
const
  NodeSize : array [0..pred(MaxSkipLevels)] of integer =
             (16, 20, 24, 28, 32, 36, 40, 44,
              48, 52, 56, 60, 64, 68, 72, 76);
type
  PslnmPage = ^TslnmPage;
  TslnmPage = packed record
    slnmpNext  : PslnmPage;
    slnmpSize  : longint;
    slnmpNodes : TByteArray;
  end;
{--------}
var
  slnmFreeList : TslNodeArray; {ie, a free list per node size}
  slnmPageList : PslnmPage;
{--------}
procedure slnmFreeNode(aNode : PslNode; aLevel : integer);
begin
  {$IFDEF UseNodeManager}
  {add the node to the top of the correct free list}
  aNode^.slnNext[0] := slnmFreeList[aLevel];
  slnmFreeList[aLevel] := aNode;
  {$ELSE}
  FreeMem(aNode, NodeSize[aLevel]);
  {$ENDIF}
end;
{--------}
procedure slnmAllocPage(aLevel : integer);
var
  NewPage : PslnmPage;
  i       : integer;
  PageSize: integer;
  Offset  : integer;
begin
  {get a new page}
  PageSize := sizeof(pointer) + {the slnmpNext field}
              sizeof(longint) + {the slnmpSize field}
              (PageNodeCount * NodeSize[aLevel]); {the nodes}
  GetMem(NewPage, PageSize);
  NewPage^.slnmpSize := PageSize;
  {add it to the current list of pages}
  NewPage^.slnmpNext := slnmPageList;
  slnmPageList := NewPage;
  {add all the nodes on the page to the free list}
  Offset := 0;
  for i := 0 to pred(PageNodeCount) do begin
    slnmFreeNode(@NewPage^.slnmpNodes[Offset], aLevel);
    inc(Offset, NodeSize[aLevel]);
  end;
end;
{--------}
function slnmAllocNode(aLevel : integer) : PslNode;
begin
  {$IFDEF UseNodeManager}
  {if the free list is empty, allocate a new page of nodes}
  if (slnmFreeList[aLevel] = nil) then
    slnmAllocPage(aLevel);
  {return the first node on the free list}
  Result := slnmFreeList[aLevel];
  slnmFreeList[aLevel] := Result^.slnNext[0];
  {$ELSE}
  GetMem(Result, NodeSize[aLevel]);
  {$ENDIF}
  Result^.slnLevel := aLevel;
end;
{====================================================================}


{===TaaSkipList======================================================}
constructor TaaSkipList.Create(aCompare : TaaCompareFunction);
var
  i : integer;
begin
  inherited Create;
  {allocate a head node}
  FHead := slnmAllocNode(pred(MaxSkipLevels));
  FHead^.slnData := nil;
  {allocate a tail node}
  FTail := slnmAllocNode(0);
  FTail^.slnData := nil;
  {point the head and tail pointers to each other}
  for i := 0 to pred(MaxSkipLevels) do begin
    FHead^.slnNext[i] := FTail;
    FTail^.slnNext[i] := nil;
  end;
  FHead^.slnPrev := nil;
  FTail^.slnPrev := FHead;
  {set the cursor to the head node}
  FCursor := FHead;
  {save the compare function}
  FCompare := aCompare;
end;
{--------}
destructor TaaSkipList.Destroy;
begin
  Clear;
  slnmFreeNode(FHead, FHead^.slnLevel);
  slnmFreeNode(FTail, FTail^.slnLevel);
  inherited Destroy;
end;
{--------}
procedure TaaSkipList.Clear;
var
  Temp : PslNode;
begin
  Temp := FHead^.slnNext[0];
  while (Temp <> nil) do begin
    FHead^.slnNext[0] := Temp^.slnNext[0];
    slnmFreeNode(Temp, Temp^.slnLevel);
    Temp := FHead^.slnNext[0];
  end;
  FCount := 0;
end;
{--------}
function TaaSkipList.Delete : pointer;
var
  i, Level    : integer;
  Temp        : PslNode;
  BeforeNodes : TslNodeArray;
begin
  {we can't delete at the head or tail}
  if (FCursor = FHead) or (FCursor = FTail) then
    raise Exception.Create('TaaSkipList.Delete: cannot delete - cursor is not on an item');
  {search for the item and create the BeforeNodes array}
  if not slSearchPrim(FCursor^.slnData, BeforeNodes) then
    raise Exception.Create('TaaSkipList.Delete: item is missing');
  {the only valid before nodes are from the skip list's maximum level
   down to this node's level; we need to get the before nodes for the
   others}
  Level := FCursor^.slnLevel;
  if (Level > 0) then begin
    for i := pred(Level) downto 0 do begin
      BeforeNodes[i] := BeforeNodes[i+1];
      while (BeforeNodes[i]^.slnNext[i] <> FCursor) do
        BeforeNodes[i] := BeforeNodes[i]^.slnNext[i];
    end;
  end;
  {patch up the links on level 0 - doubly linked list}
  BeforeNodes[0]^.slnNext[0] := FCursor^.slnNext[0];
  FCursor^.slnNext[0]^.slnPrev := BeforeNodes[0];
  {patch up the links on the other levels - all singly linked lists}
  for i := 1 to Level do begin
    BeforeNodes[i].slnNext[i] := FCursor^.slnNext[i];
  end;
  {reset cursor, dispose of the node}
  Result := FCursor^.slnData;
  Temp := FCursor;
  FCursor := FCursor^.slnNext[0];
  slnmFreeNode(Temp, Level);
  {we now have one less node in the skip list}
  dec(FCount);
end;
{--------}
function TaaSkipList.Examine : pointer;
begin
  {return the data part of the cursor}
  Result := FCursor^.slnData;
end;
{--------}
procedure TaaSkipList.Insert(aItem : pointer);
var
  i, Level    : integer;
  NewNode     : PslNode;
  BeforeNodes : TslNodeArray;
begin
  {search for the item and create the BeforeNodes array}
  if slSearchPrim(aItem, BeforeNodes) then
    raise Exception.Create('TaaSkipList.Insert: duplicate item');
  {calculate the level for the new node}
  Level := 0;
  while (Level <= MaxLevel) and (Random < 0.25) do
    inc(Level);
  {if we've gone beyond the maximum level, save it}
  if (Level > MaxLevel) then
    inc(FMaxLevel);
  {allocate the new node}
  NewNode := slnmAllocNode(Level);
  NewNode^.slnData := aItem;
  {patch up the links on level 0 - a doubly linked list}
  NewNode^.slnPrev := BeforeNodes[0];
  NewNode^.slnNext[0] := BeforeNodes[0].slnNext[0];
  BeforeNodes[0].slnNext[0] := NewNode;
  NewNode^.slnNext[0]^.slnPrev := NewNode;
  {patch up the links on the other levels - all singly linked lists}
  for i := 1 to Level do begin
    NewNode^.slnNext[i] := BeforeNodes[i].slnNext[i];
    BeforeNodes[i].slnNext[i] := NewNode;
  end;
  {we now have one more node in the skip list}
  inc(FCount);
end;
{--------}
function TaaSkipList.IsAfterLast : boolean;
begin
  Result := FCursor = FTail;
end;
{--------}
function TaaSkipList.IsBeforeFirst : boolean;
begin
  Result := FCursor = FHead;
end;
{--------}
procedure TaaSkipList.MoveAfterLast;
begin
  {set the cursor to the tail node}
  FCursor := FTail;
end;
{--------}
procedure TaaSkipList.MoveBeforeFirst;
begin
  {set the cursor to the head node}
  FCursor := FHead;
end;
{--------}
function TaaSkipList.MoveNext : boolean;
begin
  {advance the cursor to its own next pointer}
  if (FCursor = FTail) then
    Result := false
  else begin
    FCursor := FCursor^.slnNext[0];
    Result := true;
  end;
end;
{--------}
function TaaSkipList.MovePrior : boolean;
begin
  {advance the cursor to its own previous pointer}
  if (FCursor = FHead) then
    Result := false
  else begin
    FCursor := FCursor^.slnPrev;
    Result := true;
  end;
end;
{--------}
{$IFDEF InDebugMode}
procedure TaaSkipList.Print;
var
  BeforeNodes : TslNodeArray;
  i           : integer;
  Temp        : PslNode;
  TempLevel   : integer;
begin
  {set the BeforeNodes array to point to the head node}
  for i := 0 to pred(MaxSkipLevels) do
    BeforeNodes[i] := FHead;
  Temp := FHead;
  TempLevel := Temp^.slnLevel;
  for i := 0 to TempLevel do
    write('*');
  writeln;
  Temp := Temp^.slnNext[0];
  while Temp <> FTail do begin
    TempLevel := Temp^.slnLevel;
    if (BeforeNodes[TempLevel]^.slnNext[TempLevel] <> Temp) then begin
      writeln('---Wrong pointer from before');
      readln;
    end;
    for i := 0 to TempLevel do
      BeforeNodes[i] := Temp;
    for i := 0 to TempLevel do
      write('*');
    writeln;
    Temp := Temp^.slnNext[0];
  end;
end;
{$ENDIF}
{--------}
function TaaSkipList.Search(aItem : pointer) : boolean;
var
  BeforeNodes : TslNodeArray;
begin
  Result := slSearchPrim(aItem, BeforeNodes);
end;
{--------}
function TaaSkipList.slSearchPrim(aItem : pointer;
                              var aBeforeNodes : TslNodeArray) : boolean;
var
  Level  : integer;
  Walker : PslNode;
  Temp   : PslNode;
  CmpResult : integer;
begin
  {set the BeforeNodes array to point to the head node}
  for Level := 0 to pred(MaxSkipLevels) do
    aBeforeNodes[Level] := FHead;
  {initialize}
  Walker := FHead;
  Level := MaxLevel;
  {start zeroing in on the item we want}
  while (Level >= 0) do begin
    Temp := Walker^.slnNext[Level];
    if (Temp = FTail) then
      {pretend that the tail's data is greater than our item}
      CmpResult := 1
    else
      {compare the next node's data with our item}
      CmpResult := FCompare(Temp^.slnData, aItem);
    if (CmpResult = 0) then begin
      {if equal then we found the item}
      aBeforeNodes[Level] := Walker;
      FCursor := Temp;
      Result := true;
      Exit;
    end;
    if (CmpResult < 0) then begin
      {if less than, then advance the walker node}
      Walker := Temp;
    end
    else begin
      {if greater than, save the before node, drop down a level}
      aBeforeNodes[Level] := Walker;
      dec(Level);
    end;
  end;
  {if we reach this point, the item is not in the skip list}
  Result := false;
end;
{====================================================================}


procedure FinalizeUnit;
var
  STemp : PslnmPage;
begin
  {destroy all the single node pages}
  STemp := slnmPageList;
  while (STemp <> nil) do begin
    slnmPageList := STemp^.slnmpNext;
    FreeMem(STemp, STemp^.slnmpSize);
    STemp := slnmPageList;
  end;
end;

procedure InitializeUnit;
var
  i : integer;
begin
  {set all global lists to nil}
  for i := 0 to pred(MaxSkipLevels) do
    slnmFreeList[i] := nil;
  slnmPageList := nil;
end;

initialization
  InitializeUnit;

finalization
  FinalizeUnit;

end.